home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / Fred (editor) utilities.sea / Fred (editor) utilities / shift.lisp < prev    next >
Encoding:
Text File  |  1993-02-26  |  2.4 KB  |  62 lines  |  [TEXT/CCL2]
  1. ;;
  2. ;; shift-left  (function key F8)
  3. ;; shifts each line in the selection left by 1 character
  4. ;; 
  5. ;; shift-right (function key F9)
  6. ;; shifts each line in the selection right by 1 character
  7. ;; 
  8. ;; quote-selection (function key F10)
  9. ;; shifts each line in the selection right by 1 character inserting a >
  10. ;; 
  11. ;; both key functions are undo-able
  12. ;;
  13. ;;    Copyright © 1992 John R. Montbriand.  All Rights Reserved.
  14.  
  15.  
  16.  
  17. (defmethod shift-left ((w fred-mixin))
  18.   "shifts each line in the selection to the left by one character"
  19.   (multiple-value-bind (start end) (selection-range w)
  20.     (prog ((line-starts nil) (append-p nil))
  21.       (do ((i start (1+ i))) ((and line-starts (>= i end)))
  22.         (multiple-value-bind (position-of-start shortfall)
  23.                              (buffer-line-start (fred-buffer w) i 0)
  24.           (declare (ignore shortfall))
  25.           (if (null (member position-of-start line-starts))
  26.             (push position-of-start line-starts))))
  27.       (dolist (pos line-starts)
  28.         (if (char= #\Space (buffer-char (fred-buffer w) pos))
  29.           (progn
  30.             (setq *last-command* nil)
  31.             (ed-delete-with-undo w pos (1+ pos) nil nil append-p)
  32.             (setq append-p t))))
  33.       (if append-p (set-fred-undo-string w "shift left")))))
  34.  
  35. (defmethod shift-in ((w fred-mixin) shift-in-char)
  36.   "shifts each line in the selection to the right by one character"
  37.   (multiple-value-bind (start end) (selection-range w)
  38.     (prog ((line-starts nil) (append-p nil))
  39.       (do ((i start (1+ i))) ((and line-starts (>= i end)))
  40.         (multiple-value-bind (position-of-start shortfall)
  41.                              (buffer-line-start (fred-buffer w) i 0)
  42.           (declare (ignore shortfall))
  43.           (if (null (member position-of-start line-starts))
  44.             (push position-of-start line-starts))))
  45.       (dolist (pos line-starts)
  46.         (ed-insert-with-undo w shift-in-char pos append-p)
  47.         (setq append-p t))
  48.       (if append-p (set-fred-undo-string w "shift right")))))
  49.  
  50. (defmethod shift-right ((w fred-mixin))
  51.   "shifts each line in the selection to the right by one character"
  52.   (shift-in w #\Space))
  53.  
  54. (defmethod quote-selection ((w fred-mixin))
  55.   "quotes the selection by inserting > characters at the beginning of each line."
  56.   (shift-in w #\>))
  57.  
  58.  
  59. (comtab-set-key *comtab* '(:function #\8) 'shift-left)
  60. (comtab-set-key *comtab* '(:function #\9) 'shift-right)
  61. (comtab-set-key *comtab* '(:function #\a) 'quote-selection)
  62.